home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 010 / games.arc / FUNCTION.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1980-01-01  |  4.8 KB  |  267 lines
  1. 10  ' **********************
  2. 20  ' **     FUNCTION     **
  3. 30  ' **********************
  4. 40  '
  5. 50  CLEAR
  6. 60  SCREEN 0,0,0,0
  7. 70  WIDTH 80
  8. 80  KEY OFF
  9. 90  '
  10. 100  WHILE NOT FINISHED
  11. 110  CLS
  12. 120  PRINT TAB(18)"* * *   FUNCTION ANALYSIS   * * *
  13. 130  LOCATE 4
  14. 140  PRINT TAB(21)"Analysis in an interval
  15. 150  PRINT
  16. 160  PRINT TAB(26)"<1>   Minimum point
  17. 170  PRINT TAB(26)"<2>   Maximum point
  18. 180  PRINT TAB(26)"<3>   Zero point
  19. 190  PRINT TAB(26)"<4>   Area by integration
  20. 200  PRINT TAB(26)"<5>   Sketch
  21. 210  PRINT
  22. 220  PRINT TAB(21)"Analysis at a point
  23. 230  PRINT
  24. 240  PRINT TAB(26)"<6>   Value of f(X)
  25. 250  PRINT TAB(26)"<7>   First derivative
  26. 260  PRINT
  27. 270  PRINT TAB(26)"<8>   End
  28. 280  PRINT
  29. 290  PRINT
  30. 300  PRINT
  31. 310  PRINT TAB(21)"....  SELECT ONE  ....";
  32. 320  GOSUB 440
  33. 330  ON SELECTION GOSUB 870,1120,1370,1800,2030,2430,2510,390,370
  34. 340  WEND
  35. 350  '
  36. 360  ' Subroutine, immediate return for choice "9"
  37. 370  RETURN
  38. 380  '
  39. 390  ' Terminate program
  40. 400  CLS
  41. 410  END
  42. 420  '
  43. 430  ' Subroutine, wait for digit selection
  44. 440  K$ = INKEY$
  45. 450  IF K$ = "" THEN 440
  46. 460  IF K$ < "1" OR K$ > "9" THEN 440
  47. 470  SELECTION = VAL(K$)
  48. 480  RETURN
  49. 490  '
  50. 500  ' Subroutine, get X for point of concern
  51. 510  CLS
  52. 520  LOCATE 9,9
  53. 530  INPUT "Enter value for X ...  ",X
  54. 540  RETURN
  55. 550  '
  56. 560  ' Subroutine, get X1 and X2 for interval
  57. 570  CLS
  58. 580  LOCATE 7,9
  59. 590  PRINT "Interval will be from X1 to X2 ...
  60. 600  LOCATE 10,9
  61. 610  INPUT "Enter value for X1 ...  ",X1
  62. 620  LOCATE 11,9
  63. 630  INPUT "Enter value for X2 ...  ",X2
  64. 640  IF X2 < X1 THEN SWAP X1, X2
  65. 650  RETURN
  66. 660  '
  67. 670  ' Subroutine, wait for user before proceeding
  68. 680  PRINT
  69. 690  PRINT
  70. 700  PRINT
  71. 710  PRINT "Press <space bar> to continue ...";
  72. 720  K$ = INKEY$
  73. 730  IF K$ <> " " THEN 720
  74. 740  RETURN
  75. 750  '
  76. 760  ' Subroutine, slope of function given a delta
  77. 770  XT = X
  78. 780  X = XT - DELTA / 2
  79. 790  GOSUB 9000
  80. 800  Y1 = Y
  81. 810  X = XT + DELTA / 2
  82. 820  GOSUB 9000
  83. 830  SLOPE = (Y - Y1) / DELTA
  84. 840  X = XT
  85. 850  RETURN
  86. 860  '
  87. 870  ' Minimum
  88. 880  GOSUB 570
  89. 890  CLS
  90. 900  PRINT "Finding a minimum point ...
  91. 910  PRINT
  92. 920  WHILE X1 <> X2
  93. 930  PRINT ,,X1,X2
  94. 940  FOR DX = 0 TO 10
  95. 950  X = X1 + DX * (X2 - X1) / 10
  96. 960  GOSUB 9000
  97. 970  IF DX > 0 AND Y > MIN THEN 1000
  98. 980  MIN = Y
  99. 990  X3 = DX
  100. 1000  NEXT DX
  101. 1010  X4 = X1
  102. 1020  X5 = X2
  103. 1030  IF X3 < 6 THEN X2 = X1 + 6 * (X2 - X1) / 10
  104. 1040  IF X3 > 5 THEN X1 = X1 + 5 * (X2 - X1) / 10
  105. 1050  IF X1 = X4 AND X2 = X5 THEN X1 = X2
  106. 1060  WEND
  107. 1070  PRINT
  108. 1080  PRINT "Minimum point at X = ";X1;" is Y = ";Y
  109. 1090  GOSUB 680
  110. 1100  RETURN
  111. 1110  '
  112. 1120  ' Maximum
  113. 1130  GOSUB 570
  114. 1140  CLS
  115. 1150  PRINT "Finding a maximum point ...
  116. 1160  PRINT
  117. 1170  WHILE X1 <> X2
  118. 1180  PRINT ,,X1,X2
  119. 1190  FOR DX = 0 TO 10
  120. 1200  X = X1 + DX * (X2 - X1) / 10
  121. 1210  GOSUB 9000
  122. 1220  IF DX > 0 AND Y < MAX THEN 1250
  123. 1230  MAX = Y
  124. 1240  X3 = DX
  125. 1250  NEXT DX
  126. 1260  X4 = X1
  127. 1270  X5 = X2
  128. 1280  IF X3 < 6 THEN X2 = X1 + 6 * (X2 - X1) / 10
  129. 1290  IF X3 > 5 THEN X1 = X1 + 5 * (X2 - X1) / 10
  130. 1300  IF X1 = X4 AND X2 = X5 THEN X1 = X2
  131. 1310  WEND
  132. 1320  PRINT
  133. 1330  PRINT "Maximum point at X = ";X1;" is Y = ";Y
  134. 1340  GOSUB 680
  135. 1350  RETURN
  136. 1360  '
  137. 1370  ' Zero
  138. 1380  GOSUB 570
  139. 1390  CLS
  140. 1400  PRINT "Looking for zero crossing between X1 = ";X1;" and X2 = ";X2
  141. 1410  X = X1
  142. 1420  GOSUB 9000
  143. 1430  Y1 = Y
  144. 1440  X = X2
  145. 1450  GOSUB 9000
  146. 1460  Y2 = Y
  147. 1470  IF SGN(Y1) <> SGN(Y2) THEN 1600
  148. 1480  FOR I = 1 TO 27
  149. 1490  X = X1 + I * (X2 - X1) / 28
  150. 1500  GOSUB 9000
  151. 1510  IF SGN(Y) = SGN(Y1) THEN 1540
  152. 1520  X2 = X
  153. 1530  Y2 = Y
  154. 1540  NEXT I
  155. 1550  IF SGN(Y1) * SGN(Y2) = -1 THEN 1600
  156. 1560  PRINT
  157. 1570  PRINT "There doesn't appear to be a zero crossing point
  158. 1580  PRINT "in the given interval.
  159. 1590  GOTO 1770
  160. 1600  PRINT
  161. 1610  WHILE X1 <> X2
  162. 1620  PRINT ,,X1,X2
  163. 1630  X = (X1 + X2) / 2
  164. 1640  GOSUB 9000
  165. 1650  X3 = X1
  166. 1660  X4 = X2
  167. 1670  IF SGN(Y) = SGN(Y1) THEN 1710
  168. 1680  X2 = X
  169. 1690  Y2 = Y
  170. 1700  GOTO 1730
  171. 1710  X1 = X
  172. 1720  Y1 = Y
  173. 1730  IF X1 = X3 AND X2 = X4 THEN X1 = X2
  174. 1740  WEND
  175. 1750  PRINT
  176. 1760  PRINT "Zero crossing is very near X = ";X
  177. 1770  GOSUB 680
  178. 1780  RETURN
  179. 1790  '
  180. 1800  ' Subroutine, integration
  181. 1810  GOSUB 570
  182. 1820  CLS
  183. 1830  PRINT "Integration by Simpson's rule ...
  184. 1840  LOCATE 5,1
  185. 1850  PRINT "Area under curve from X1 = ";X1;" to X2 = ";X2
  186. 1860  PRINT
  187. 1870  FOR I = 2 TO 7
  188. 1880  AREA = 0
  189. 1890  INC = 2 ^ I
  190. 1900  H = (X2 - X1) / INC
  191. 1910  FLG = 1
  192. 1920  FOR J = 0 TO INC
  193. 1930  FLG = -(FLG = 0)
  194. 1940  X = X1 + J * H
  195. 1950  GOSUB 9000
  196. 1960  AREA = AREA + Y + Y + 2 * Y * FLG + Y * ((J=0)+(J=INC))
  197. 1970  NEXT J
  198. 1980  PRINT "Area found with"INC"steps = "TAB(29) AREA * H / 3
  199. 1990  NEXT I
  200. 2000  GOSUB 680
  201. 2010  RETURN
  202. 2020  '
  203. 2030  ' Graph
  204. 2040  GOSUB 570
  205. 2050  CLS
  206. 2060  LOCATE 12,22
  207. 2070  PRINT "Finding sketch boundaries ...
  208. 2080  X = X1
  209. 2090  GOSUB 9000
  210. 2100  YMIN = Y
  211. 2110  YMAX = Y
  212. 2120  FOR I = 0 TO 100
  213. 2130  X = X1 + I * (X2 - X1) / 100
  214. 2140  GOSUB 9000
  215. 2150  IF Y < YMIN THEN YMIN = Y
  216. 2160  IF Y > YMAX THEN YMAX = Y
  217. 2170  NEXT I
  218. 2180  SCREEN 2
  219. 2190  LOCATE 3,1
  220. 2200  PRINT YMAX
  221. 2210  LOCATE 20,1
  222. 2220  PRINT YMIN
  223. 2230  LOCATE 22,12
  224. 2240  PRINT X1;TAB(77-LEN(STR$(X2)))X2
  225. 2250  LOCATE 1,35
  226. 2260  PRINT "SKETCH OF  Y = f(X)
  227. 2270  LINE (92,164)-(608,16),,B
  228. 2280  LINE (98,162)-(602,18),,B
  229. 2290  PAINT (95,161)
  230. 2300  FOR I = 0 TO 500 STEP 5
  231. 2310  X = X1 + I * (X2 - X1) / 500
  232. 2320  GOSUB 9000
  233. 2330  IF I THEN 2360
  234. 2340  PSET (100 + I, 160 - 140 * (Y - YMIN) / (YMAX - YMIN))
  235. 2350  GOTO 2370
  236. 2360  LINE -(100 + I, 160 - 140 * (Y - YMIN) / (YMAX - YMIN))
  237. 2370  NEXT I
  238. 2380  LOCATE 25,14
  239. 2390  GOSUB 710
  240. 2400  SCREEN 0,0,0,0
  241. 2410  RETURN
  242. 2420  '
  243. 2430  ' Value of f(X)
  244. 2440  GOSUB 510
  245. 2450  GOSUB 9000
  246. 2460  PRINT
  247. 2470  PRINT "Value of f(X) at X = ";X;" is Y = ";Y
  248. 2480  GOSUB 680
  249. 2490  RETURN
  250. 2500  '
  251. 2510  ' First derivative
  252. 2520  GOSUB 510
  253. 2530  CLS
  254. 2540  PRINT ," DELTA"," SLOPE      ...   at X = ";X
  255. 2550  PRINT
  256. 2560  FOR I = 0 TO 4
  257. 2570  DELTA = VAL("1E-"+STR$(I))
  258. 2580  GOSUB 770
  259. 2590  PRINT ,DELTA,SLOPE
  260. 2600  NEXT I
  261. 2610  GOSUB 680
  262. 2620  RETURN
  263. 2630  '
  264. 2640  ' Subroutine, user defined Y = f(X)
  265. 9000  IF X = 0 THEN Y = 1 ELSE Y = SIN(X)/X
  266. 9010  RETURN
  267.